home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 2 / CU Amiga Magazine's Super CD-ROM 02 (1996)(EMAP Images)(GB)[!][issue 1996-04].iso / magazine / amiga_e / peps / peps.e < prev    next >
Text File  |  1994-05-02  |  33KB  |  849 lines
  1. /*=========================================================================
  2.  = Peps v0.1 © 1994 NasGûl
  3.  =========================================================================*/
  4.  
  5. OPT OSVERSION=37
  6.  
  7. MODULE 'intuition/intuition','gadtools','libraries/gadtools','intuition/gadgetclass','intuition/screens',
  8.        'graphics/text','exec/lists','exec/nodes','exec/ports','eropenlib','utility/tagitem',
  9.        'rexxsyslib','rexx/storage'
  10. MODULE 'dos/dosextens','peps','dos/dostags'
  11. MODULE 'reqtools','libraries/reqtools','graphics/displayinfo'
  12.  
  13. CONST DEBUG=FALSE   /* for dWriteF() Proc */
  14.  
  15. CONST FIND_INTERNAL=0, /* for p_FindProcName() Proc */
  16.       FIND_AREXX=1
  17.  
  18. /* All "programm don't work.." errors */
  19.  
  20. ENUM ER_NONE,ER_LOCKSCREEN,ER_VISUAL,ER_CONTEXT,ER_MENUS,ER_GADGET,ER_WINDOW,
  21.      ER_BADARGS,ER_ONLYCLI,ER_NOFILE,ER_TEMPNOVALID,ER_PORTEXIST,ER_CREATEPORT,
  22.      ER_MEM,ER_RUNED,ER_CONOUT,ER_EXENOVALID,ER_SAMEDIR,ER_OPENSCREEN,ER_SCREENSIG,
  23.      ER_LIST,ER_MENUS,ER_NOMENUFILE
  24.  
  25. RAISE ER_MEM IF New()=NIL,
  26.       ER_MEM IF String()=NIL
  27.  
  28. DEF screen:PTR TO screen,       /* like examples/gadtoolsdemo.e */
  29.     visual=NIL,
  30.     tattr:PTR TO textattr,
  31.     menu=NIL,
  32.     reelquit=FALSE,
  33.     offy
  34. /*=======================================
  35.  = pp Definitions
  36.  =======================================*/
  37. DEF pp_window=NIL:PTR TO window            /* Window and gadgets list */
  38. DEF pp_glist=NIL
  39. /*==================*/
  40. /*     Gadgets      */
  41. /*==================*/
  42. CONST GA_G_SOURCE=0                        /* gadgets num */
  43. CONST GA_G_FILELIST=1
  44. CONST GA_G_PROCLIST=2
  45. CONST GA_G_ERRORSLIST=3
  46. /*=============================
  47.  = Gadgets labels of pp
  48.  =============================*/
  49. DEF g_source                              /* gadgets adr */
  50. DEF g_filelist
  51. DEF g_proclist
  52. DEF g_errorslist
  53. /*==========================
  54.  = Arg Definitions
  55.  ==========================*/
  56. DEF esource[100]:STRING        /* the source name */
  57. DEF ecsource[100]:STRING       /* the source file without .e */
  58. DEF ec[100]:STRING             /* ec options (-e by default) */
  59. DEF pubscreenname[100]:STRING  /* pubscreenname for window (Workbench by def) */
  60. DEF menufile[256]:STRING       /* file who content menus */
  61. DEF nomenu=FALSE               /* no menu */
  62. DEF screensig=-1               /* signal for pubscreen */
  63. DEF typescreen=SUPER_KEY       /* type of screen */
  64. DEF screenbydefault=FALSE      /* pubscreen by def */
  65. DEF screenshanghai=FALSE
  66. DEF editorcommand[100]:STRING  /* the name of your text editor (ED <esource> byf def */
  67. DEF tempfile[100]:STRING       /* name of the temp file ( T:PepsMain.e by def) */
  68. DEF b_deletetemp=FALSE         /* delete temp (TRUE/FALSE) ( FALSE by def) */
  69. DEF compilandexit=FALSE        /* Compil and exit */
  70. DEF insertcomment=FALSE        /* InsertComment in PepsMain.e */
  71. DEF prgportname[100]:STRING    /* the name of the Arexx Port (PepsPort by def) */
  72. DEF edarexxportname[100]:STRING    /* Port arexx for Editor */
  73. DEF arexxport:PTR TO mp        /* Arexx Port of Peps */
  74. DEF dummyport:PTR TO mp        /* DummyReplyPort */
  75. DEF execname[256]:STRING       /* Exec Name (the name of the source code without the .e by def) */
  76. DEF myb:PTR TO eubase          /* My base (see Peps.m and Peps.doc) */
  77. DEF myout                      /* handle for ec output */
  78. DEF myconout[256]:STRING       /* window out description */
  79. DEF emptylist:PTR TO lh        /* just a empty list (lh) */
  80. DEF currentfilenode            /* the current filenode (seleted in the ListView gaget (File) */
  81. DEF erscriptname[256]:STRING,arexxer=TRUE
  82. DEF currentdir[256]:STRING     /* the current dir when launch */
  83. PMODULE 'PepsData'
  84. PMODULE 'PepsMenus'
  85. PMODULE 'Pmodules:DWriteF'
  86. PROC p_LookAllMessage() /*"p_LookAllMessage()"*/
  87. /*===============================================================================
  88.  = Para         : NONE
  89.  = Return       : NONE
  90.  = Description  : Look message on window,arexx port and Ctrl C/D/E/F.
  91.  ==============================================================================*/
  92.     DEF sigreturn
  93.     DEF ppport:PTR TO mp
  94.     IF pp_window THEN ppport:=pp_window.userport ELSE ppport:=NIL
  95.     sigreturn:=Wait(Shl(1,ppport.sigbit) OR
  96.             Shl(1,arexxport.sigbit) OR $F000)
  97.     IF (sigreturn AND Shl(1,ppport.sigbit))
  98.         p_LookppMessage()
  99.     ENDIF
  100.     IF (sigreturn AND Shl(1,arexxport.sigbit))
  101.         p_LookArexxMessage()
  102.     ENDIF
  103.     IF (sigreturn AND $F000)
  104.         reelquit:=TRUE
  105.     ENDIF
  106. ENDPROC
  107. PROC p_LookppMessage() /*"p_LookppMessage()"*/
  108. /*===============================================================================
  109.  = Para         : NONE
  110.  = Return       : NONE
  111.  = Description  : Look Idcmp message.
  112.  ==============================================================================*/
  113.    DEF mes:PTR TO intuimessage
  114.    DEF g:PTR TO gadget
  115.    DEF type=0,infos=NIL
  116.    DEF curfile:PTR TO filenode,ret,adr_menu,ms,number
  117.    ms:=pp_window.menustrip
  118.    WHILE (mes:=Gt_GetIMsg(pp_window.userport))
  119.        type:=mes.class
  120.        SELECT type
  121.        CASE IDCMP_MENUPICK
  122.             ret:=mes.code
  123.             IF ret<>$FFFF
  124.                 adr_menu:=ItemAddress(ms,ret)
  125.                 SELECT ret
  126.                     CASE $F800
  127.                         EasyRequestArgs(0,[20,0,0,'Peps v0.1','Ok'],0,NIL)
  128.                     CASE $F820
  129.                         Execute('Newshell',0,stdout)
  130.                     CASE $F840
  131.                         p_RebuildMenu()
  132.                     CASE $F860
  133.                         reelquit:=TRUE
  134.                     DEFAULT
  135.                         number:=p_ExecuteMenu(ms,adr_menu)
  136.                 ENDSELECT
  137.             ENDIF
  138.        CASE IDCMP_REFRESHWINDOW
  139.            p_RenderppWindow()
  140.        CASE IDCMP_CLOSEWINDOW
  141.            reelquit:=TRUE
  142.        CASE IDCMP_GADGETUP
  143.           g:=mes.iaddress
  144.           infos:=g.gadgetid
  145.           SELECT infos
  146.           CASE GA_G_SOURCE
  147.           CASE GA_G_FILELIST
  148.               currentfilenode:=mes.code
  149.               curfile:=p_GetAdrNode(myb.pmodulelist,currentfilenode)
  150.               Gt_SetGadgetAttrsA(g_proclist,pp_window,NIL,[GTLV_LABELS,p_EmptyList(curfile.proclist),TAG_DONE,0])
  151.           CASE GA_G_PROCLIST
  152.           CASE GA_G_ERRORSLIST
  153.           ENDSELECT
  154.        ENDSELECT
  155.        Gt_ReplyIMsg(mes)
  156.    ENDWHILE
  157.    WHILE (mes:=Gt_GetIMsg(pp_window.userport)) DO Gt_ReplyIMsg(mes)
  158. ENDPROC
  159. PROC p_LookArexxMessage() /*"p_LookArexxMessage()"*/
  160. /*===============================================================================
  161.  = Para         : NONE
  162.  = Return       : NONE
  163.  = Description  : Process arexx Messge.
  164.  ==============================================================================*/
  165.     DEF mess_rexx:PTR TO rexxmsg
  166.     DEF commande:PTR TO LONG
  167.     DEF test
  168.     DEF execcom[256]:STRING,dodel=TRUE
  169.     DEF ret_str[256]:STRING
  170.     dWriteF(['p_LookArexxMessge()\n'],0)
  171.     WHILE (mess_rexx:=GetMsg(arexxport))
  172.     IF IsRexxMsg(mess_rexx)
  173.         commande:=mess_rexx.args
  174.         IF StrCmp(commande[0],'EC',ALL) /* Make compilation */
  175.             WindowToFront(pp_window)
  176.             p_CleanAllList()
  177.             IF (p_ReadSourceFile(esource,TRUE))<>FALSE
  178.                 p_RenderppWindow()
  179.                 p_WriteFPmoduleList(myb.pmodulelist)
  180.                 p_CalculTotalMem(myb.pmodulelist)
  181.                 StringF(execcom,'EC \s \s',ec,ecsource)
  182.                 IF (test:=p_Execute(execcom))<>0
  183.                     WindowToFront(pp_window)
  184.                     p_ParsingError(myb.pmodulelist,test)
  185.                 ELSE
  186.                 IF (test:=p_CopyFile(ecsource,execname))=FALSE
  187.                     p_AjouteInfoNode(myb.infolist,'Error Copy Exec.')
  188.                     dodel:=FALSE
  189.                 ENDIF
  190.             ENDIF
  191.         ELSE
  192.             p_CleanAllList()
  193.             p_AjouteInfoNode(myb.infolist,'Internal Error.')
  194.         ENDIF
  195.         IF ((b_deletetemp=TRUE) AND (dodel=TRUE))
  196.             DeleteFile(tempfile)
  197.             test:=InStr(tempfile,'.e',0)
  198.             MidStr(execcom,tempfile,0,test)
  199.             DeleteFile(execcom)
  200.             p_AjouteInfoNode(myb.infolist,'Delete TempFile.')
  201.          ENDIF
  202.         ELSEIF StrCmp(commande[0],'QUIT',ALL) /* Quit */
  203.             reelquit:=TRUE
  204.         ELSEIF StrCmp(commande[0],'ECOPT',ALL)
  205.             p_ChangeECOpt()
  206.         ELSEIF StrCmp(commande[0],'FINDPROC',8)
  207.             MidStr(execcom,commande[0],8,ALL)
  208.             execcom:=TrimStr(execcom)
  209.             ret_str:=p_FindProcName(myb.pmodulelist,execcom,FIND_AREXX)
  210.             StringF(execcom,'\s',ret_str)
  211.             mess_rexx.result2:=String(EstrLen(execcom))
  212.             StrCopy(mess_rexx.result2,execcom,ALL)
  213.         ELSEIF StrCmp(commande[0],'NEWSHELL',ALL)
  214.             Execute('NewShell',0,stdout)
  215.         ENDIF
  216.     ENDIF
  217.     ReplyMsg(mess_rexx)
  218.     IF mess_rexx.result2 THEN DisposeLink(mess_rexx.result2)
  219.     ENDWHILE
  220.     WHILE (mess_rexx:=GetMsg(arexxport)) DO ReplyMsg(arexxport)
  221. ENDPROC
  222. PROC p_ChangeECOpt() /*"p_ChangeECOpt()"*/
  223. /*===============================================================================
  224.  = Para         : NONE
  225.  = Return       : NONE
  226.  = Description  : Call StringRequester to change EC Options.
  227.  ==============================================================================*/
  228.     DEF str_return[256]:STRING
  229.     IF (str_return:=p_GetWithStringReq('Change EC options',ec))<>NIL THEN ec:=str_return
  230. ENDPROC
  231. PROC p_GetWithStringReq(titre,texte) /*"p_GetWithStringReq(titre,texte)"*/
  232. /*===============================================================================
  233.  = Para         : title of the StringRequester,Text in String Gadget.
  234.  = Return       : new string if ok,else NIL.
  235.  = Description  : PopUp a StringRequester (ReqTools.library).
  236.  ==============================================================================*/
  237.     DEF req:PTR TO rtfilerequester
  238.     DEF return_string[256]:STRING
  239.     DEF retour
  240.     return_string:=NIL
  241.     IF req:=RtAllocRequestA(RT_REQINFO,NIL)
  242.     retour:=RtGetStringA(texte,300,titre,NIL,[RT_WINDOW,pp_window,RT_LOCKWINDOW,TRUE,TAG_DONE,0])
  243.     IF retour THEN return_string:=texte
  244.     RtFreeRequest(req)
  245.     ENDIF
  246.     RETURN return_string
  247. ENDPROC return_string
  248. PROC p_ReadSourceFile(s,inglobal) /*"p_ReadSourceFile(s,inglobal)"*/
  249. /*===============================================================================
  250.  = Para         : Source file (main file or pmodule),inglobal always TRUE.
  251.  = Return       : FALSE if error,else TRUE.
  252.  = Description  : Read Source File. (file who not exists are skipped).
  253.  ==============================================================================*/
  254.     DEF len,adr,buf,handle,flen=TRUE,a=0,p=0
  255.     DEF r_str[256]:STRING
  256.     DEF a_str[256]:STRING
  257.     DEF str_line[256]:STRING
  258.     DEF piv_str[256]:STRING
  259.     DEF procstr[256]:STRING,pos,newmod[256]:STRING
  260.     DEF debp,finp
  261.     DEF myfilenode:PTR TO filenode
  262.     DEF myprocnode:PTR TO procnode
  263.     DEF lg=0
  264.     DEF inproc=FALSE
  265.     DEF nocopyproc=FALSE
  266.     StringF(a_str,'Error File:\s',s)
  267.     IF (flen:=FileLength(s))=-1
  268.         p_AjouteInfoNode(myb.infolist,a_str)
  269.         RETURN FALSE
  270.     ELSEIF (buf:=New(flen+1))=NIL
  271.         p_AjouteInfoNode(myb.infolist,a_str)
  272.         RETURN FALSE
  273.     ELSEIF (handle:=Open(s,1005))=NIL
  274.         IF buf THEN Dispose(buf)
  275.         p_AjouteInfoNode(myb.infolist,a_str)
  276.         RETURN FALSE
  277.     ENDIF
  278.     len:=Read(handle,buf,flen)
  279.     Close(handle)
  280.     IF len<1
  281.     IF buf THEN Dispose(buf)
  282.         p_AjouteInfoNode(myb.infolist,a_str)
  283.         RETURN FALSE
  284.     ENDIF
  285.     adr:=buf
  286.     IF FindName(myb.pmodulelist,s)
  287.         StringF(a_str,'File \s Exists.\n',s)
  288.         p_AjouteInfoNode(myb.infolist,a_str)
  289.         IF buf THEN Dispose(buf)
  290.         RETURN FALSE
  291.     ELSE
  292.         myfilenode:=New(SIZEOF filenode)
  293.         myfilenode.deflist:=p_InitList()
  294.         myfilenode.proclist:=p_InitList()
  295.         p_AjouteNode(myb.pmodulelist,s,myfilenode.node)
  296.     ENDIF
  297.     StringF(a_str,'New File :\s',s)
  298.     p_AjouteInfoNode(myb.infolist,a_str)
  299.     FOR a:=0 TO len-1
  300.         IF buf[a]=10
  301.             lg:=a-p
  302.             IF lg<>0
  303.                 StrCopy(r_str,adr,lg)
  304.                 str_line:=TrimStr(r_str)
  305.                 IF StrCmp(str_line,'PROC',4)
  306.                     inglobal:=FALSE
  307.                     inproc:=TRUE
  308.                     debp:=adr-buf
  309.                     pos:=InStr(str_line,'(',0)
  310.                     StrCopy(procstr,str_line,pos+1)
  311.                     IF p_FindProcName(myb.pmodulelist,procstr,FIND_INTERNAL)
  312.                         StringF(a_str,'Proc \s Exists.\n',procstr)
  313.                         p_AjouteInfoNode(myb.infolist,a_str)
  314.                         nocopyproc:=TRUE
  315.                         JUMP suite
  316.                     ELSE
  317.                         myprocnode:=New(SIZEOF procnode)
  318.                         p_AjouteNode(myfilenode.proclist,procstr,myprocnode.node)
  319.                         p_AjouteNode(myb.proclist,procstr,0)
  320.                         StringF(a_str,'New Proc :\s',procstr)
  321.                         p_AjouteInfoNode(myb.infolist,a_str)
  322.                        JUMP suite
  323.                     ENDIF
  324.                 ELSEIF StrCmp(str_line,'ENDPROC',7)
  325.                     IF nocopyproc=FALSE
  326.                         inglobal:=TRUE
  327.                         inproc:=FALSE
  328.                         finp:=adr-buf
  329.                         myprocnode.length:=finp-debp+EstrLen(str_line)
  330.                         myprocnode.buffer:=New(myprocnode.length)
  331.                         CopyMem(buf+debp,myprocnode.buffer,myprocnode.length)
  332.                         JUMP suite
  333.                     ELSE
  334.                         inglobal:=TRUE
  335.                         inproc:=FALSE
  336.                         JUMP suite
  337.                     ENDIF
  338.                 ELSEIF StrCmp(str_line,'PMODULE',7)
  339.                     piv_str:=found_para('PMODULE',str_line,'\a')
  340.                     IF piv_str
  341.                         StringF(newmod,'\s.e',piv_str)
  342.                         p_ReadSourceFile(newmod,TRUE)
  343.                         inglobal:=TRUE
  344.                         inproc:=FALSE
  345.                     ENDIF
  346.                     JUMP suite
  347.                 ELSEIF ((inglobal=TRUE) AND (inproc=FALSE))
  348.                     p_AjouteNode(myfilenode.deflist,r_str,0)
  349.                     JUMP suite
  350.                 ENDIF
  351.             ENDIF
  352.             suite:
  353.             p:=a+1
  354.             adr:=buf+a+1
  355.         ENDIF
  356.     ENDFOR
  357.     Dispose(buf)
  358.     RETURN TRUE
  359. ENDPROC
  360. PROC found_para(str_para,parse_str,sep) /*"found_para(str_para,parse_str,sep)"*/
  361. /*===============================================================================
  362.  = Para         : the string,the key word (ex: string=PMODULE 'Mod1' keywod=PMODULE).
  363.  = Return       : the parameter if ok,else NIL.
  364.  = Description  : found the paramater of a key word.
  365.  ==============================================================================*/
  366.     DEF p[256]:STRING,pos_dep,pos_fin
  367.     pos_dep:=InStr(parse_str,str_para,0)
  368.     IF pos_dep<>-1
  369.     pos_dep:=InStr(parse_str,sep,pos_dep)
  370.     pos_fin:=InStr(parse_str,sep,pos_dep+1)
  371.     MidStr(p,parse_str,pos_dep+1,(pos_fin-pos_dep)-1)
  372.     RETURN p
  373.     ELSE
  374.     RETURN FALSE
  375.     ENDIF
  376. ENDPROC
  377. PROC p_WriteFPmoduleList(ptr_list:PTR TO lh) /*"p_WriteFPmoduleList(ptr_list:PTR TO lh)"*/
  378. /*===============================================================================
  379.  = Para         : Address of a list (the eubase.pmodulelist).
  380.  = Return       : NONE.
  381.  = Description  : Write the TemFile.
  382.  ==============================================================================*/
  383.     DEF w_fnode:PTR TO ln
  384.     DEF w_pnode:PTR TO ln
  385.     DEF w_filenode:PTR TO filenode
  386.     DEF w_procnode:PTR TO procnode
  387.     DEF pivlist:PTR TO lh
  388.     DEF defnode:PTR TO ln
  389.     DEF h,commentstr[256]:STRING
  390.     IF h:=Open(tempfile,1006)
  391.         w_filenode:=ptr_list.head
  392.         WHILE w_filenode
  393.             w_fnode:=w_filenode
  394.             IF w_fnode.succ<>0
  395.                 IF p_EmptyList(w_filenode.deflist)<>-1
  396.                     IF insertcomment=TRUE
  397.                         StringF(commentstr,'/*============================\n'+
  398.                                            ' = Def include From :\s\n'+
  399.                                            ' ============================*/\n',w_fnode.name)
  400.                         Write(h,commentstr,EstrLen(commentstr))
  401.                     ENDIF
  402.                     pivlist:=w_filenode.deflist
  403.                     defnode:=pivlist.head
  404.                     WHILE defnode
  405.                         IF defnode.succ<>0
  406.                             Write(h,defnode.name,EstrLen(defnode.name))
  407.                             Write(h,'\n',1)
  408.                         ENDIF
  409.                         defnode:=defnode.succ
  410.                     ENDWHILE
  411.                 ENDIF
  412.             ENDIF
  413.             w_filenode:=w_fnode.succ
  414.         ENDWHILE
  415.         w_filenode:=ptr_list.head
  416.         WHILE w_filenode
  417.             w_fnode:=w_filenode
  418.             IF w_fnode.succ<>0
  419.                 IF p_EmptyList(w_filenode.proclist)<>-1
  420.                     IF insertcomment=TRUE
  421.                         StringF(commentstr,'/*============================\n'+
  422.                                            ' = Proc include From :\s\n'+
  423.                                            ' ============================*/\n',w_fnode.name)
  424.                         Write(h,commentstr,EstrLen(commentstr))
  425.                     ENDIF
  426.                     pivlist:=w_filenode.proclist
  427.                     w_procnode:=pivlist.head
  428.                     WHILE w_procnode
  429.                         w_pnode:=w_procnode
  430.                         IF w_pnode.succ<>0
  431.                             Write(h,w_procnode.buffer,w_procnode.length)
  432.                             Write(h,'\n',1)
  433.                             IF CtrlC() THEN JUMP fin
  434.                         ENDIF
  435.                         w_procnode:=w_pnode.succ
  436.                     ENDWHILE
  437.                 ENDIF
  438.             ENDIF
  439.             w_filenode:=w_fnode.succ
  440.         ENDWHILE
  441.         fin:
  442.         IF h THEN Close(h)
  443.     ELSE
  444.         p_AjouteInfoNode(myb.infolist,'Save Temp Error.')
  445.     ENDIF
  446. ENDPROC
  447. PROC p_FindProcName(ptr_list:PTR TO lh,pname,mode) /*"p_FindProcName(ptr_list:PTR TO lh,pname,mode)"*/
  448. /*===============================================================================
  449.  = Para     : address of list,name of proc
  450.  = Return   : TRUE if proc is already in list else FALSE.
  451.  = Description  : Find a proc name.
  452.  ==============================================================================*/
  453.     DEF w_fnode:PTR TO ln
  454.     DEF w_filenode:PTR TO filenode
  455.     DEF return_str[256]:STRING
  456.     DEF bufstr[256]:STRING,lock
  457.     w_filenode:=ptr_list.head
  458.     WHILE w_filenode
  459.     w_fnode:=w_filenode
  460.     IF w_fnode.succ<>0
  461.         IF p_EmptyList(w_filenode.proclist)<>-1
  462.             IF FindName(w_filenode.proclist,pname) 
  463.                 IF mode=FIND_INTERNAL 
  464.                     RETURN TRUE
  465.                 ELSEIF mode=FIND_AREXX
  466.                     IF lock:=Lock(w_fnode.name,-2)
  467.                         NameFromLock(lock,bufstr,256)
  468.                         AddPart(bufstr,'',256)
  469.                         StrAdd(bufstr,w_fnode.name,ALL)
  470.                         UnLock(lock)
  471.                     ENDIF
  472.                     IF (p_LookIfFullName(bufstr))=TRUE
  473.                         StringF(return_str,'\s \s',bufstr,w_fnode.name)
  474.                     ELSE
  475.                         StringF(return_str,'\s\s \s',currentdir,bufstr,w_fnode.name)
  476.                     ENDIF
  477.                     RETURN return_str
  478.                 ENDIF
  479.             ENDIF
  480.         ENDIF
  481.     ENDIF
  482.     w_filenode:=w_fnode.succ
  483.     ENDWHILE
  484.     IF mode=FIND_INTERNAL THEN RETURN FALSE ELSE RETURN ''
  485. ENDPROC
  486. PROC p_ParsingError(ptr_list:PTR TO lh,errorline) /*"p_ParsingError(ptr_list:PTR TO lh,errorline)"*/
  487. /*===============================================================================
  488.  = Para         : Address of a list (eubase.pmodulelist),num line error.
  489.  = Return       : NONE
  490.  = Description  : Count line to find the file/proc error.
  491.  ==============================================================================*/
  492.     DEF w_fnode:PTR TO ln
  493.     DEF w_pnode:PTR TO ln
  494.     DEF w_filenode:PTR TO filenode
  495.     DEF w_procnode:PTR TO procnode
  496.     DEF curline=0,numline=0
  497.     DEF pivlist:PTR TO lh
  498.     DEF defnode:PTR TO ln
  499.     DEF debline=0
  500.     DEF strarexx[256]:STRING
  501.     DEF fullname[256]:STRING
  502.     DEF bufstr[256]:STRING
  503.     DEF lock
  504.     w_filenode:=ptr_list.head
  505.     WHILE w_filenode
  506.     w_fnode:=w_filenode
  507.     IF w_fnode.succ<>0
  508.         IF p_EmptyList(w_filenode.deflist)<>-1
  509.         IF insertcomment=TRUE
  510.             curline:=curline+3
  511.         ENDIF
  512.         pivlist:=w_filenode.deflist
  513.         defnode:=pivlist.head
  514.         WHILE defnode
  515.             IF defnode.succ<>0
  516.             IF curline=errorline
  517.                 p_AjouteInfoNode(myb.infolist,'Error In Globals Def.')
  518.                 IF arexxer=TRUE
  519.                 StringF(fullname,'\s',w_fnode.name)
  520.                 IF lock:=Lock(fullname,-2)
  521.                     NameFromLock(lock,bufstr,256)
  522.                     AddPart(bufstr,'',256)
  523.                     StrAdd(bufstr,fullname,ALL)
  524.                     dWriteF(['p_ParsingError() Lock ok Full\s ','Name\s\n'],[bufstr,w_fnode.name])
  525.                     UnLock(lock)
  526.                 ENDIF
  527.                 IF (p_LookIfFullName(fullname))=TRUE
  528.                     StringF(strarexx,'\s \s \s',erscriptname,bufstr,w_fnode.name)
  529.                 ELSE
  530.                     StringF(strarexx,'\s \s\s \s',erscriptname,currentdir,bufstr,w_fnode.name)
  531.                 ENDIF
  532.                 p_SendRexxCommand(strarexx,'REXX',RXCOMM+RXFF_RESULT)
  533.                 ENDIF
  534.                 JUMP errorfound
  535.             ENDIF
  536.             INC curline
  537.             ENDIF
  538.             defnode:=defnode.succ
  539.         ENDWHILE
  540.         ENDIF
  541.     ENDIF
  542.     w_filenode:=w_fnode.succ
  543.     ENDWHILE
  544.     w_filenode:=ptr_list.head
  545.     WHILE w_filenode
  546.     w_fnode:=w_filenode
  547.     IF w_fnode.succ<>0
  548.         IF p_EmptyList(w_filenode.proclist)<>-1
  549.         IF insertcomment=TRUE
  550.             curline:=curline+3
  551.         ENDIF
  552.         pivlist:=w_filenode.proclist
  553.         w_procnode:=pivlist.head
  554.         WHILE w_procnode
  555.             w_pnode:=w_procnode
  556.             IF w_pnode.succ<>0
  557.             debline:=curline
  558.             numline:=p_CountLine(w_procnode.buffer,w_procnode.length)
  559.             curline:=curline+numline
  560.             IF ((errorline>debline) AND (errorline<curline))
  561.                 p_AjouteInfoNode(myb.infolist,'Error In File:')
  562.                 p_AjouteInfoNode(myb.infolist,w_fnode.name)
  563.                 p_AjouteInfoNode(myb.infolist,'Error In Proc:')
  564.                 p_AjouteInfoNode(myb.infolist,w_pnode.name)
  565.                 IF compilandexit
  566.                 WriteF('Error In File:\s\n',w_fnode.name)
  567.                 WriteF('Error In Proc:\s\n',w_pnode.name)
  568.                 ENDIF
  569.                 IF arexxer=TRUE
  570.                 StringF(fullname,'\s',w_fnode.name)
  571.                 IF lock:=Lock(fullname,-2)
  572.                     NameFromLock(lock,bufstr,256)
  573.                     AddPart(bufstr,'',256)
  574.                     StrAdd(bufstr,w_fnode.name,ALL)
  575.                     dWriteF(['p_ParsingError() Lock ok Full\s ','Name\s\n'],[bufstr,fullname])
  576.                     UnLock(lock)
  577.                 ENDIF
  578.                 IF p_LookIfFullName(fullname)
  579.                     StringF(strarexx,'\s \s \s \s',erscriptname,bufstr,w_fnode.name,w_pnode.name)
  580.                 ELSE
  581.                     StringF(strarexx,'\s \s\s \s \s',erscriptname,currentdir,bufstr,w_fnode.name,w_pnode.name)
  582.                 ENDIF
  583.                 p_SendRexxCommand(strarexx,'REXX',RXCOMM+RXFF_RESULT)
  584.                 ENDIF
  585.                 JUMP errorfound
  586.             ENDIF
  587.             ENDIF
  588.             w_procnode:=w_pnode.succ
  589.         ENDWHILE
  590.         ENDIF
  591.     ENDIF
  592.     w_filenode:=w_fnode.succ
  593.     ENDWHILE
  594.     errorfound:
  595. ENDPROC
  596. PROC p_CountLine(buff,l) /*"p_CountLine(buff,l)"*/
  597. /*===============================================================================
  598.  = Para         : address of buffer (procnode.buffer),length of buffer (procnode.length)
  599.  = Return       : the number of line (PROC=1 and ENDPROC=number of line).
  600.  = Description  : count buffer line.
  601.  ==============================================================================*/
  602.     DEF adr,pos,line=0,longlu=0
  603.     adr:=buff
  604.     REPEAT
  605.     pos:=InStr(adr,'\n',1)
  606.     INC line
  607.     adr:=adr+pos+1
  608.     longlu:=longlu+pos+1
  609.     UNTIL ((pos=-1) OR (longlu=l))
  610.     RETURN line
  611. ENDPROC
  612. PROC p_CalculTotalMem(list:PTR TO lh) /*"p_CalculTotalMem(list:PTR TO lh)"*/
  613. /*===============================================================================
  614.  = Para         : Address of a list (eubase.pmodulelist).
  615.  = Return       : NONE.
  616.  = Description  : count total mem use.
  617.  ==============================================================================*/
  618.     DEF fnode:PTR TO ln
  619.     DEF pnode:PTR TO ln
  620.     DEF mfilenode:PTR TO filenode
  621.     DEF mprocnode:PTR TO procnode
  622.     DEF totalsize=0,pivlist:PTR TO lh
  623.     DEF a_str[256]:STRING
  624.     mfilenode:=list.head
  625.     WHILE mfilenode
  626.     fnode:=mfilenode
  627.     IF fnode.succ<>0
  628.         totalsize:=totalsize+EstrLen(fnode.name)+SIZEOF filenode
  629.         pivlist:=mfilenode.proclist
  630.         mprocnode:=pivlist.head
  631.         IF p_EmptyList(mfilenode.proclist)<>-1
  632.         totalsize:=totalsize+SIZEOF lh
  633.         WHILE mprocnode
  634.             pnode:=mprocnode
  635.             IF pnode.succ<>0
  636.                 totalsize:=totalsize+EstrLen(pnode.name)+SIZEOF procnode+mprocnode.length
  637.             ENDIF
  638.             mprocnode:=pnode.succ
  639.         ENDWHILE
  640.         ENDIF
  641.     ENDIF
  642.     mfilenode:=fnode.succ
  643.     ENDWHILE
  644.     StringF(a_str,'»»»» TotalBytes :\d',totalsize)
  645.     p_AjouteInfoNode(myb.infolist,a_str)
  646. ENDPROC
  647. PROC p_Execute(command) /*"p_Execute(command)"*/
  648. /*===============================================================================
  649.  = Para         : the command string.
  650.  = Return       : the returncode.
  651.  = Description  : run a prg.
  652.  ==============================================================================*/
  653.     DEF ret
  654.     ret:=SystemTagList(command,[SYS_OUTPUT,myout,
  655.                 SYS_INPUT,Input(),
  656.              NP_STACKSIZE,8000,
  657.              NP_PRIORITY,0,
  658.              0])
  659.     RETURN ret
  660. ENDPROC
  661. PROC p_RunEditor() /*"p_RunEditor()"*/
  662. /*===============================================================================
  663.  = Para         : NONE
  664.  = Return       : the returncode.
  665.  = Description  : Runback the editor.
  666.  ==============================================================================*/
  667.     DEF r
  668.     r:=SystemTagList(editorcommand,[SYS_OUTPUT,myout,SYS_INPUT,NIL,SYS_ASYNCH,TRUE,SYS_USERSHELL,TRUE,NP_STACKSIZE,8000,
  669.                NP_PRIORITY,0,NP_PATH,NIL,NP_CONSOLETASK,NIL,TAG_DONE])
  670.     RETURN r
  671. ENDPROC
  672. PROC p_CopyFile(source,destination) /*"p_CopyFile(source,destination)"*/
  673. /*===============================================================================
  674.  = Para         : source file,destination file
  675.  = Return       : TRUE if ok,else FALSE.
  676.  = Description  : Copy a file.
  677.  ==============================================================================*/
  678.  
  679.     DEF hs,hd,buf,lo,lt,lf
  680.     DEF ret=FALSE
  681.     IF hs:=Open(source,1005)
  682.     IF (lf:=FileLength(source))<>-1
  683.         IF buf:=New(lf+1)
  684.         IF lo:=Read(hs,buf,lf)
  685.             IF hd:=Open(destination,1006)
  686.             lt:=Write(hd,buf,lo)
  687.             IF lt=lo THEN ret:=TRUE
  688.             Close(hd)
  689.             ENDIF
  690.         ENDIF
  691.         ENDIF
  692.         IF buf THEN Dispose(buf)
  693.     ENDIF
  694.     Close(hs)
  695.     ENDIF
  696.     RETURN ret
  697. ENDPROC
  698. PROC p_SendRexxCommand(comrexx,portname,action_mode) /*"p_SendRexxCommand(comrexx,portname,action_mode)"*/
  699. /*===============================================================================
  700.  = Para         : Arexx script name.
  701.  = Return       : NONE.
  702.  = Description  : send arexx message (parsing errors).
  703.  ==============================================================================*/
  704.     DEF rc=FALSE
  705.     DEF rarg:PTR TO rexxarg
  706.     DEF rxmsg:PTR TO rexxmsg
  707.     DEF retxmsg:PTR TO rexxmsg
  708.     DEF ap:PTR TO mp
  709.     DEF test:PTR TO LONG
  710.     DEF execmsg:PTR TO mn
  711.     DEF node:PTR TO ln
  712.     DEF return_str[256]:STRING
  713.     dWriteF(['p_SendRexxCommand() \s',' \s','\h\n'],[comrexx,portname,action_mode])
  714.     IF rxmsg:=CreateRexxMsg(dummyport,NIL,NIL)
  715.         execmsg:=rxmsg
  716.         node:=execmsg
  717.         node.name:='REXX'
  718.         node.type:=NT_MESSAGE
  719.         node.pri:=0
  720.         execmsg.replyport:=dummyport
  721.         IF test:=CreateArgstring(comrexx,EstrLen(comrexx))
  722.             CopyMem({test},rxmsg.args,4)
  723.             rxmsg.action:=action_mode
  724.             rxmsg.passport:=dummyport
  725.             rxmsg.stdin:=Input()
  726.             rxmsg.stdout:=myout
  727.             Forbid()
  728.             ap:=FindPort(portname)
  729.             IF ap
  730.                 PutMsg(ap,rxmsg)
  731.             ENDIF
  732.             Permit()
  733.             IF ap
  734.                 WaitPort(dummyport)
  735.                 IF retxmsg:=GetMsg(dummyport)
  736.                     rc:=retxmsg.result1
  737.                     rarg:=retxmsg.result2
  738.                     IF rc=0
  739.                         p_AjouteInfoNode(myb.infolist,'Arexx Macro.')
  740.                     ELSE
  741.                         StringF(return_str,'Arexx Error :\d',rc)
  742.                         p_AjouteInfoNode(myb.infolist,return_str)
  743.                     ENDIF
  744.                     /*IF retxmsg THEN ReplyMsg(retxmsg)*/
  745.                 ENDIF
  746.             ELSE
  747.                 p_AjouteInfoNode(myb.infolist,'Editor Port no found.')
  748.             ENDIF
  749.             IF test THEN ClearRexxMsg(rxmsg,16)
  750.         ENDIF
  751.         IF rxmsg THEN DeleteRexxMsg(rxmsg)
  752.     ENDIF
  753. ENDPROC
  754. PROC p_LookIfFullName(nom) /*"p_LookIfFullName(nom)"*/
  755. /*===============================================================================
  756.  = Para         : filename.
  757.  = Return       : TRUE if filename content : or /.
  758.  = Description  : like name proc.
  759.  ==============================================================================*/
  760.     DEF lpos
  761.     IF ((lpos:=InStr(nom,':',0)<>-1) OR
  762.        (lpos:=InStr(nom,'/',0)<>-1)) THEN RETURN TRUE
  763.     RETURN FALSE
  764. ENDPROC
  765.  
  766. PROC main() HANDLE /*"main()"*/
  767. /*===============================================================================
  768.  = Para         : NONE
  769.  = Return       : ER_NONE if ok,else FALSE.
  770.  = Description  : Main Proc.
  771.  ==============================================================================*/
  772.     DEF testmain
  773.     DEF execcom[256]:STRING
  774.     tattr:=['topaz.font',8,0,0]:textattr
  775.     VOID '$VER:Peps v0.1 © 1994 NasGûl (26-05-94)'
  776.     IF wbmessage<>NIL
  777.         Raise(ER_ONLYCLI)
  778.     ELSE
  779.         IF (testmain:=p_StartCli())<>ER_NONE THEN Raise(testmain)
  780.     ENDIF
  781.     IF compilandexit=FALSE
  782.         IF (testmain:=p_RunEditor())>0 THEN Raise(ER_RUNED)
  783.     ENDIF
  784.     IF (testmain:=p_OpenLibraries())<>ER_NONE THEN Raise(testmain)
  785.     IF (testmain:=p_CreateArexxPort(prgportname,0))<>ER_NONE THEN Raise(testmain)
  786.     IF (dummyport:=CreateMsgPort())=NIL THEN Raise(ER_CREATEPORT)
  787.     IF (testmain:=p_InitPeps())<>ER_NONE THEN Raise(testmain)
  788.     IF (testmain:=p_SetUpScreen())<>ER_NONE THEN Raise(testmain)
  789.     IF nomenu=FALSE
  790.         p_RebuildMenu()
  791.     ENDIF
  792.     IF (testmain:=p_InitppWindow())<>ER_NONE THEN Raise(testmain)
  793.     IF (testmain:=p_OpenppWindow())<>ER_NONE THEN Raise(testmain)
  794.     IF (testmain:=p_OpenConsole())<>ER_NONE THEN Raise(testmain)
  795.     p_CleanAllList()
  796.     p_ReadSourceFile(esource,TRUE)
  797.     p_RenderppWindow()
  798.     IF compilandexit
  799.         p_WriteFPmoduleList(myb.pmodulelist)
  800.         p_CalculTotalMem(myb.pmodulelist)
  801.         StringF(execcom,'EC \s \s',ec,ecsource)
  802.         IF (testmain:=p_Execute(execcom))<>0
  803.             WindowToFront(pp_window)
  804.             p_ParsingError(myb.pmodulelist,testmain)
  805.         ELSE
  806.             StringF(execcom,'Copy \s \s',ecsource,execname)
  807.             Execute(execcom,0,stdout)
  808.         ENDIF
  809.         Raise(ER_NONE)
  810.     ENDIF
  811.     REPEAT
  812.         p_LookAllMessage()
  813.     UNTIL reelquit=TRUE
  814.     Raise(ER_NONE)
  815. EXCEPT
  816.     IF myout THEN p_CloseConsole()
  817.     IF pp_window THEN p_RemppWindow()
  818.     IF screen THEN p_SetDownScreen()
  819.     IF myb THEN p_RemPeps()
  820.     IF dummyport THEN DeleteMsgPort(dummyport)
  821.     IF arexxport THEN p_DeleteArexxPort(arexxport)
  822.     p_CloseLibraries()
  823.     SELECT exception
  824.     /*============= CLI ERROR ==================*/
  825.     CASE ER_BADARGS;    WriteF('Bad Args.\n')
  826.     CASE ER_ONLYCLI;    WriteF('Only Cli.\n')
  827.     CASE ER_NOFILE;     WriteF('Can\at find file \s.\n',esource)
  828.     CASE ER_TEMPNOVALID; WriteF('TempFile Invalid.\n')
  829.     CASE ER_PORTEXIST;   WriteF('Port \s exist.\n',prgportname)
  830.     CASE ER_CREATEPORT;  WriteF('can\at create port.\n')
  831.     CASE ER_EXENOVALID;  WriteF('ExecName Invalid.\n')
  832.     CASE ER_SAMEDIR;     WriteF('Peps Same dir than source code.\n')
  833.     CASE ER_NOMENUFILE;  WriteF('can\at find the menufile \s.\n',menufile)
  834.     /*============= WINDOW ERROR ================*/
  835.     CASE ER_LOCKSCREEN; WriteF('Lock Screen Failed.')
  836.     CASE ER_VISUAL;     WriteF('Error Visual.')
  837.     CASE ER_CONTEXT;    WriteF('Error Context.')
  838.     CASE ER_MENUS;      WriteF('Error Menus.')
  839.     CASE ER_GADGET;     WriteF('Error Gadget.')
  840.     CASE ER_WINDOW;     WriteF('Error Window.')
  841.     CASE ER_OPENSCREEN; WriteF('Can\at Open Screen.\n')
  842.     CASE ER_CONOUT;     WriteF('Error Console Window.\n')
  843.     CASE ER_SCREENSIG;  WriteF('Can\at Allocate Signal for the screen.\n')
  844.     /*============= APP ERROR =================*/
  845.     CASE ER_RUNED;      WriteF('Need Editor.\n')
  846.     ENDSELECT
  847.     CleanUp(0)
  848. ENDPROC
  849.